home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / oberon / abu.mod < prev    next >
Text File  |  1991-02-24  |  8KB  |  269 lines
  1. MODULE Abu ;    (*  ERV, 1989 *)
  2.  IMPORT Screen, Disk, Term, Parms;
  3.  
  4. CONST maxbuff = 32000 ;
  5.       Maxrow = Screen.maxrow - 1 ;
  6.       maxfname = 12;
  7.  
  8. TYPE  BuffTyp = ARRAY maxbuff OF CHAR ;
  9.       BuffPtr = POINTER TO BuffTyp ;
  10.       LinePtr = POINTER TO LineRec;
  11.       LineRec = RECORD
  12.                   next,prior : LinePtr;
  13.                   offset,limit : INTEGER
  14.                 END ;
  15.       SrchStg = ARRAY 40 OF CHAR;
  16.       Fname = ARRAY maxfname+1 OF CHAR;
  17.  
  18.       XferPtr = POINTER TO Xfer;
  19.       Xfer = RECORD
  20.               next, prior :XferPtr;
  21.               name : Fname;
  22.               Buff:BuffPtr; BuffEnd:INTEGER;
  23.               TOF,BOF,topline : LinePtr;
  24.               lastsrch:SrchStg; coldelta:INTEGER
  25.              END;
  26.  
  27.       FileNameTyp = ARRAY 64 OF CHAR;
  28.  
  29. VAR fhandle : INTEGER;
  30.  
  31.     BuffEnd : INTEGER;
  32.     coldelta: INTEGER;
  33.     Buff : BuffPtr ;
  34.     TOF,BOF,topline : LinePtr ;
  35.     lastsrch : SrchStg;
  36.  
  37.     XFcurrent:XferPtr;
  38.  
  39.  
  40. PROCEDURE Err(s:ARRAY OF CHAR);
  41. VAR cl:INTEGER; ch:CHAR;
  42. BEGIN
  43.   cl := Screen.Color;  Screen.Color := 70H;
  44.   Screen.EraseLine(0); Screen.WrtStr(s,0,0);
  45.   Screen.EraseLine(1); Screen.WrtStr("Press any key to continue",1,0);
  46.   Term.RdKey(ch); IF ch = 0X THEN Term.RdKey(ch) END;
  47.   Screen.Color := cl
  48. END Err;
  49.  
  50.  
  51. PROCEDURE FileToStrings ;
  52. VAR i:INTEGER; ch:CHAR;  p,p0:LinePtr;
  53. BEGIN i := 0;
  54.   p0 := TOF ;  NEW(p);  p.offset := i;
  55.   WHILE i < BuffEnd DO
  56.     ch := Buff[i];
  57.     IF ch = 0AX THEN Buff[i] := 00X;
  58.          p.limit := i;
  59.          p.next := p0.next;  p.prior := p0;  p.next.prior := p;
  60.          p0.next := p;  p0 := p;
  61.          NEW(p);  p.offset := i + 1
  62.     ELSIF ch < " " THEN Buff[i] := " "
  63.     END;
  64.     INC(i)
  65.   END
  66. END FileToStrings;
  67.  
  68.  
  69. PROCEDURE GetFile(VAR fn:ARRAY OF CHAR) : BOOLEAN ;
  70. VAR ans:BOOLEAN; p:LinePtr;
  71. BEGIN  ans := fn[0] # 0X ;
  72.   IF ans THEN
  73.     Disk.FileOpen(fn, fhandle, 0) ;
  74.     IF fhandle = 0 THEN Err("Cannot find file") ; ans := FALSE END;
  75.     IF ans THEN
  76.       Disk.FileRd(Buff^, fhandle, maxbuff, BuffEnd);
  77.       IF BuffEnd = 0 THEN Err("File is empty"); ans := FALSE
  78.       ELSE FileToStrings
  79.       END ;
  80.       Disk.FileClose(fhandle)
  81.     END
  82.   END;
  83.   IF ~ans THEN
  84.     NEW(p); p.next := BOF; p.prior := TOF; p.limit := 0; p.offset := 0;
  85.     TOF.next := p; BOF.prior := p; Buff[0] := 0X
  86.   END;
  87.   RETURN ans
  88. END GetFile;
  89.  
  90. PROCEDURE ShowScreen ;
  91. VAR r,c:INTEGER; p:LinePtr;  s:ARRAY 4 OF CHAR;
  92. BEGIN r := Screen.minrow;  c := Screen.mincol;  p := topline ;  s[0] := 00X;
  93.   WHILE (p # BOF) & (r <= Maxrow) DO
  94.     Screen.WrtSp(Buff^, p.offset+coldelta, p.limit, r, c);
  95.     INC(r);  p := p.next
  96.   END;
  97.   WHILE r <= Maxrow DO Screen.WrtSp(s,0,0,r,c); INC(r) END
  98. END ShowScreen;
  99.  
  100. PROCEDURE PageDown;
  101. VAR i:INTEGER;
  102. BEGIN
  103.   i := Maxrow - Screen.minrow - 1; (*bottom line shows as new top line*)
  104.   WHILE (i > 0) & (topline.next # BOF) DO
  105.     topline := topline.next;  DEC(i)
  106.   END;
  107.   ShowScreen
  108. END PageDown;
  109.  
  110. PROCEDURE PageUp;
  111. VAR i:INTEGER;
  112. BEGIN
  113.   i := Maxrow - Screen.minrow;
  114.   WHILE (i > 0) & (topline.prior # TOF) DO
  115.     topline := topline.prior;  DEC(i)
  116.   END;
  117.   ShowScreen
  118. END PageUp;
  119.  
  120. PROCEDURE Query(VAR s:ARRAY OF CHAR; prompt:ARRAY OF CHAR);
  121. VAR cl,i:INTEGER;
  122. BEGIN
  123.   i := 0; WHILE prompt[i] # 0X DO INC(i) END;
  124.   IF i > 0 THEN
  125.     cl := Screen.Color;  Screen.Color := 70H;
  126.     Screen.EraseLine(0); Screen.WrtStr(prompt,0,0);
  127.     Screen.MoveCursor(0,i); Screen.SetCursorOn;  Term.RS(s);
  128.     Screen.SetCursorOff;
  129.     Screen.Color := cl;
  130.   END;
  131.   IF s[0] = 0X THEN ShowScreen END
  132. END Query;
  133.  
  134. PROCEDURE Search(repeat:BOOLEAN);
  135. VAR g,h,i,j,k:INTEGER; s:SrchStg; line:LinePtr;
  136. BEGIN
  137.   IF ~repeat THEN
  138.     Query(s, "Search for:");
  139.     line := TOF^.next;  g := line.offset;
  140.   ELSE s := lastsrch; (*repeat last search starting on next line*)
  141.     line := topline.next; g := line.offset
  142.   END;
  143.   i := 0;  WHILE s[i] # 0X DO INC(i) END;
  144.   IF i > 0 THEN lastsrch := s;
  145.     LOOP
  146.       IF line = BOF THEN EXIT
  147.       ELSIF i + g > line.limit THEN line := line.next; g := line.offset
  148.       ELSE j := g; k := i;  h := 0;
  149.         WHILE (k > 0) & (Buff[j] = s[h]) DO
  150.           DEC(k); INC(j); INC(h)
  151.         END;
  152.         IF k = 0 THEN topline := line; EXIT
  153.         ELSE INC(g)
  154.         END
  155.       END
  156.     END
  157.   END;
  158.   ShowScreen
  159. END Search;
  160.  
  161.  
  162. PROCEDURE GetFileName(VAR filename:ARRAY OF CHAR);
  163. VAR s:Parms.ParmString;  i:INTEGER;  ch:CHAR;
  164. BEGIN
  165.   filename[0] := 0X ;
  166.   Parms.ParmCount(i);
  167.   IF i > 0 THEN Parms.Parm(1,s);
  168.     i := 0;
  169.     REPEAT ch := s[i];  filename[i] := ch;  INC(i) UNTIL ch = 0X
  170.   END
  171. END GetFileName;
  172.  
  173. PROCEDURE ShowName;
  174. BEGIN Screen.WrtHi(XFcurrent.name,Screen.maxrow,0)
  175. END ShowName;
  176.  
  177. PROCEDURE SaveXF;
  178. BEGIN
  179.  XFcurrent.Buff := Buff;  XFcurrent.BuffEnd := BuffEnd;
  180.  XFcurrent.TOF := TOF; XFcurrent.BOF := BOF;
  181.  XFcurrent.topline := topline;
  182.  XFcurrent.lastsrch := lastsrch;  XFcurrent.coldelta := coldelta;
  183. END SaveXF;
  184.  
  185. PROCEDURE RestoreXF;
  186. BEGIN
  187.  Buff := XFcurrent.Buff;  BuffEnd := XFcurrent.BuffEnd;
  188.  TOF := XFcurrent.TOF;  BOF := XFcurrent.BOF;
  189.  topline := XFcurrent.topline;
  190.  lastsrch := XFcurrent.lastsrch;  coldelta := XFcurrent.coldelta;
  191. END RestoreXF;
  192.  
  193. PROCEDURE NextFile;
  194. BEGIN
  195.  SaveXF; XFcurrent := XFcurrent.next;  RestoreXF; ShowName
  196. END NextFile;
  197.  
  198. PROCEDURE InitXF(first:BOOLEAN) : BOOLEAN;
  199. VAR p:XferPtr;  s:FileNameTyp; ans:BOOLEAN;  i:INTEGER;
  200. BEGIN ans := FALSE;
  201.   IF first THEN GetFileName(s) ELSE Query(s,"New file name:") END;
  202.   IF s[0] # 0X THEN
  203.     NEW(p);  p.next := NIL;  p.prior := NIL;
  204.     i := 0;
  205.     WHILE (i < maxfname) & (s[i] # 0X) DO p.name[i] := s[i]; INC(i) END;
  206.     WHILE i < maxfname DO p.name[i] := " "; INC(i) END;
  207.     p.name[maxfname] := 0X;
  208.     NEW(p.Buff);  p.BuffEnd := 0;
  209.     NEW(p.BOF);  p.BOF.next := NIL;  p.BOF.offset := 0;
  210.     NEW(p.TOF);  p.TOF.next := p.BOF;  p.TOF.offset := 0;
  211.     p.BOF.prior := p.TOF;  p.topline := p.BOF;
  212.     p.lastsrch[0] := 00X;  p.coldelta := 0;
  213.     IF XFcurrent = NIL THEN XFcurrent := p; p.next := p;  p.prior := p;
  214.         RestoreXF
  215.     ELSE p.next := XFcurrent.next;  p.next.prior := p;  p.prior := XFcurrent;
  216.       XFcurrent.next := p; NextFile
  217.     END ;
  218.     ans := GetFile(s);
  219.     topline := TOF.next ;
  220.     ShowName; ShowScreen
  221.   END;
  222.   RETURN ans
  223. END InitXF;
  224.  
  225. PROCEDURE MainLoop;
  226. VAR ch:CHAR;
  227. BEGIN
  228.   LOOP
  229.     Term.RdKey(ch);
  230.     IF ch = 0X THEN Term.RdKey(ch);
  231.       CASE ORD(ch) OF
  232.         Term.arup  :
  233.            IF topline.prior # TOF THEN topline := topline.prior; ShowScreen END
  234.       | Term.ardown:
  235.            IF topline.next # BOF THEN topline := topline.next; ShowScreen END
  236.       | Term.arleft: IF coldelta > 0 THEN DEC(coldelta); ShowScreen END
  237.       | Term.arrt  : IF coldelta < 512 THEN INC(coldelta); ShowScreen END
  238.       | Term.pgdn  : PageDown
  239.       | Term.pgup  : PageUp
  240.       | Term.home  : coldelta := 0; topline := TOF^.next;  ShowScreen
  241.       | Term.end   : coldelta := 0; topline := BOF;  PageUp
  242.       | Term.Carleft: coldelta := 0; ShowScreen
  243.       ELSE (*nothing*)
  244.       END
  245.     ELSIF ch = 1BX (*ESC*) THEN EXIT
  246.     ELSIF ch = "/" THEN Search(FALSE)
  247.     ELSIF ch = "\" THEN Search(TRUE)
  248.     ELSIF CAP(ch) = "N" THEN
  249.       IF InitXF(FALSE) THEN (*nop*) END
  250.     ELSIF CAP(ch) = "F" THEN NextFile; ShowScreen
  251.     END
  252.   END
  253. END MainLoop;
  254.  
  255.  
  256. BEGIN  (*Abu*)
  257.   IF Screen.ColorScreen THEN
  258.      Screen.Color := 1FH   (* blue background,white letters,intense*)
  259.   ELSE Screen.Color := 07H  (*white on black*)
  260.   END;
  261.   Screen.Clear;  Screen.SetCursorOff;
  262.   Screen.WrtHi(
  263.   "             | ESC-exit  /-search  \-search again  N-new file  F-next file",
  264.    Screen.maxrow,0);
  265.   IF InitXF(TRUE) THEN MainLoop END;
  266.   Screen.Color := 07H ; (* black background, white letters*)
  267.   Screen.Clear;  Screen.MoveCursor(0,0);  Screen.SetCursorOn
  268. END Abu .
  269.